home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / OTHER_LA / YERK__ / TOOLBOX_ / CTLWIND < prev    next >
Text File  |  1990-11-25  |  3KB  |  91 lines
  1. \ 1.3.88    rfl    A window that will not scroll. This preserves the fprect
  2. \                used by fwind for scrolling.
  3. \ 11.25.90    rfl    added close: feature to nonScrollWind. This means that
  4. \                if selected and the window was from a resource, then
  5. \                the global window position will be saved in the resource,
  6. \                but the resource will not save to disk. Note that this
  7. \                defaults to window's close method.
  8.  
  9. :CLASS nonScrollWind <super window
  10.  
  11.     int    savePosition
  12.  
  13.     :M SAVEPOSITION: put: savePosition ;M
  14.  
  15. \ if the window was brought up from a resource, then save the last position
  16. \  of the window in the resource, but don't save.
  17.     :M CLOSE: get: savePosition
  18.         IF set: self 0 l->g unpack     \ get global corner
  19.             getRect: self put: tempRect
  20.             offset: tempRect get: tempRect
  21.             get: resID getres WIND -dup     \ is there a resource?
  22.             IF >ptr put: rect THEN            \ ok, so save the window coordinates
  23.         THEN
  24.         close: super ;M
  25.  
  26.     \ ( -- )  Make this GrafPort current
  27.     :M  SET:     (abs)  call SetPort    ;M
  28.  
  29.     \ ( -- )  update content area
  30.     :M  DRAW:    (abs) call BeginUpdate
  31.          savePort @xy  set: self            \ keep current fprect
  32.         exec: draw  restport gotoxy            \ call user draw routine
  33.         (abs) call EndUpdate   ;M
  34.  
  35. ;CLASS
  36.  
  37.  
  38. \ ctlWind - Window subclass adding controls
  39. \ 12/15/84  cbd Version 1
  40. \  9/04/86  ghs Fixed draw: -do draw: super first so controls are not erased
  41. \ 12/04/87    rfl note that ' ctlproc is correct
  42. \  1/03/87    rfl    super nonScrollWind
  43. Decimal
  44.  
  45. \ ( part# ctlHndl -- )  execute action for control
  46. : ctlExec    exec: [ get-ctl-obj ]  ;
  47.  
  48. \ procedure to be executed when a control is being tracked.
  49. \  ( ctlHndl int:part -- )
  50. :proc  ctlProc  word0 swap ctlExec  ;proc
  51. ' ctlProc value ctp
  52.  
  53. \ Look for control click
  54. : ctlHit? { wind \ part mpoint ^ctl action1 action2 -- bool }
  55.     where: fEvent g->l -> mpoint    \ save mouse loc
  56.     Word0  mpoint wind +base
  57.     theCtl +base    call FindControl
  58.     word0 -> part  theCtl @ -> ^ctl    \ ctl handle
  59.     part inThumb = part inCheckBox = or  part inButton = or
  60.     IF  0 ->  action1 'c ctlExec -> action2    \ only exec after release
  61.     ELSE   ctp +base -> action1
  62.         'c 2drop -> action2
  63.     THEN  ^ctl
  64.     IF word0  ^ctl  mpoint action1
  65.         call TrackControl word0
  66.         ^ctl exec> action2 true
  67.     ELSE false
  68.     THEN ;
  69.  
  70. \ Note: if your Window is a subclass of CtlWind and has scroll bars,
  71. \ it should set the scroll bars to 255 hiliting on a deactivate event.
  72. \ This can be done via the Disable: method in VScroll.
  73. :CLASS  CtlWind  <Super NonScrollWind
  74.  
  75.     \ draw the window with controls
  76.     :M  DRAW:   draw: super  (abs) call DrawControls   ;M
  77.  
  78.     \ dispose of window's controls and close the window
  79.     :M  CLOSE:  (abs) call KillControls  close: super  ;M
  80.  
  81.     \ handle a content click
  82.     :M  CONTENT:  active: self
  83.         IF  ^base ctlHit?  not
  84.             IF  exec: content THEN
  85.         ELSE  (abs) call SelectWindow
  86.         THEN
  87.     ;M
  88.  
  89. ;CLASS
  90.  
  91.